home *** CD-ROM | disk | FTP | other *** search
/ Programming Microsoft Visual Basic .NET / Programming Microsoft Visual Basic .NET (Microsoft Press)(X08-78517)(2002).bin / setup / vbnet / 12 regular expressions / exprevaluator / evaluate.vb < prev    next >
Encoding:
Text File  |  2002-03-16  |  8.6 KB  |  218 lines
  1. Imports System.Text.RegularExpressions
  2.  
  3. Module EvaluateModule
  4.  
  5.     Function Evaluate(ByVal expr As String) As Double
  6.         ' A number is a sequence of digits optionally followed by a dot and 
  7.         ' another sequence of digits. The number in parenthesis in order to 
  8.         ' define an unnamed group.
  9.         Const Num As String = "(\-?\d+\.?\d*)"
  10.         ' List of 1-operand functions.
  11.         Const Func1 As String = "(exp|log|log10|abs|sqr|sqrt|sin|cos|tan|asin|acos|atan)"
  12.         ' List of 2-operand functions.
  13.         Const Func2 As String = "(atan2)"
  14.         ' List of N-operand functions.
  15.         Const FuncN As String = "(min|max)"
  16.         ' List of predefined constants.
  17.         Const Constants As String = "(e|pi)"
  18.  
  19.         ' Define one Regex object for each supported operation.
  20.         ' They are outside the loop, so that they are compiled only once.
  21.         ' Binary operations are defined as two numbers with a symbol between them
  22.         ' optionally separated by spaces.
  23.         Dim rePower As New Regex(Num & "\s*(\^)\s*" & Num)
  24.         Dim reAddSub As New Regex(Num & "\s*([-+])\s*" & Num)
  25.         Dim reMulDiv As New Regex(Num & "\s*([*/])\s*" & Num)
  26.         ' These Regex objects resolve call to functions. (Case insensitivity.)
  27.         Dim reFunc1 As New Regex(Func1 & "\(\s*" & Num & "\s*\)", _
  28.             RegexOptions.IgnoreCase)
  29.         Dim reFunc2 As New Regex(Func2 & "\(\s*" & Num & "\s*,\s*" & Num _
  30.             & "\s*\)", RegexOptions.IgnoreCase)
  31.         Dim reFuncN As New Regex(FuncN & "\((\s*" & Num & "\s*,)+\s*" & Num _
  32.             & "\s*\)", RegexOptions.IgnoreCase)
  33.         ' This Regex object drop a + when it follows an operator.
  34.         Dim reSign1 As New Regex("([-+/*^])\s*\+")
  35.         ' This Regex object converts a double minus into a plus.
  36.         Dim reSign2 As New Regex("\-\s*\-")
  37.         ' This Regex object drops parenthesis around a number.
  38.         ' (must not be preceded by an alphanum char (it might be a function name)
  39.         Dim rePar As New Regex("(?<![A-Za-z0-9])\(\s*([-+]?\d+.?\d*)\s*\)")
  40.         ' A Regex object that tells that the entire expression is a number
  41.         Dim reNum As New Regex("^\s*[-+]?\d+\.?\d*\s*$")
  42.  
  43.         ' The Regex object deals with constants. (Requires case insensitivity.)
  44.         Dim reConst As New Regex("\s*" & Constants & "\s*", _
  45.             RegexOptions.IgnoreCase)
  46.         ' This resolves predefined constants. (Can be kept out of the loop.)
  47.         expr = reConst.Replace(expr, AddressOf DoConstants)
  48.  
  49.         ' Loop until the entire expression becomes just a number.
  50.         Do Until reNum.IsMatch(expr)
  51.             Dim saveExpr As String = expr
  52.  
  53.             ' Perform all the math operations in the source string.
  54.             ' starting with operands with higher operands.
  55.             ' Note that we continue to perform each operation until there are
  56.             ' no matches, because we must account for expressions like (12*34*56)
  57.  
  58.             ' Perform all power operations.
  59.             Do While rePower.IsMatch(expr)
  60.                 expr = rePower.Replace(expr, AddressOf DoPower)
  61.             Loop
  62.  
  63.             ' Perform all divisions and multiplications.
  64.             Do While reMulDiv.IsMatch(expr)
  65.                 expr = reMulDiv.Replace(expr, AddressOf DoMulDiv)
  66.             Loop
  67.  
  68.             ' Perform functions with variable numbers of arguments. 
  69.             Do While reFuncN.IsMatch(expr)
  70.                 expr = reFuncN.Replace(expr, AddressOf DoFuncN)
  71.             Loop
  72.  
  73.             ' Perform functions with 2 arguments. 
  74.             Do While reFunc2.IsMatch(expr)
  75.                 expr = reFunc2.Replace(expr, AddressOf DoFunc2)
  76.             Loop
  77.  
  78.             ' 1-operand functions must be processed last to deal correctly with 
  79.             ' expressions such as SIN(ATAN(1)) before we drop parenthesis 
  80.             ' pairs around numbers.
  81.             Do While reFunc1.IsMatch(expr)
  82.                 expr = reFunc1.Replace(expr, AddressOf DoFunc1)
  83.             Loop
  84.  
  85.             ' Discard + symbols (unary pluses)that follow another operator.
  86.             expr = reSign1.Replace(expr, "$1")
  87.             ' Simplify 2 consecutive minus signs into a plus sign.
  88.             expr = reSign2.Replace(expr, "+")
  89.  
  90.             ' Perform all additions and subtractions.
  91.             Do While reAddSub.IsMatch(expr)
  92.                 expr = reAddSub.Replace(expr, AddressOf DoAddSub)
  93.             Loop
  94.  
  95.             ' attempt to discard parenthesis around numbers. We can do this
  96.             expr = rePar.Replace(expr, "$1")
  97.  
  98.             ' if the expression didn't change, we have a syntax error.
  99.             ' this serves to avoid endless loops
  100.             If expr = saveExpr Then
  101.                 ' if it didn't work, exit with syntax error exception.
  102.                 Throw New SyntaxErrorException()
  103.             End If
  104.         Loop
  105.  
  106.         ' Return the expression, which is now a number.
  107.         Return CDbl(expr)
  108.     End Function
  109.  
  110.     ' These functions evaluate the actual math operations.
  111.     ' In all cases the Match object on entry has groups that identify
  112.     ' the two operands and the operator.
  113.  
  114.     Function DoConstants(ByVal m As Match) As String
  115.         Select Case m.Groups(1).Value.ToUpper
  116.             Case "PI"
  117.                 Return Math.PI.ToString
  118.             Case "E"
  119.                 Return Math.E.ToString
  120.         End Select
  121.     End Function
  122.  
  123.     Function DoPower(ByVal m As Match) As String
  124.         Dim n1 As Double = CDbl(m.Groups(1).Value)
  125.         Dim n2 As Double = CDbl(m.Groups(3).Value)
  126.         ' Group(2) is always the ^ character in this version.
  127.         Return (n1 ^ n2).ToString
  128.     End Function
  129.  
  130.     Function DoMulDiv(ByVal m As Match) As String
  131.         Dim n1 As Double = CDbl(m.Groups(1).Value)
  132.         Dim n2 As Double = CDbl(m.Groups(3).Value)
  133.         Select Case m.Groups(2).Value
  134.             Case "/"
  135.                 Return (n1 / n2).ToString
  136.             Case "*"
  137.                 Return (n1 * n2).ToString
  138.         End Select
  139.     End Function
  140.  
  141.     Function DoAddSub(ByVal m As Match) As String
  142.         Dim n1 As Double = CDbl(m.Groups(1).Value)
  143.         Dim n2 As Double = CDbl(m.Groups(3).Value)
  144.         Select Case m.Groups(2).Value
  145.             Case "+"
  146.                 Return (n1 + n2).ToString
  147.             Case "-"
  148.                 Return (n1 - n2).ToString
  149.         End Select
  150.     End Function
  151.  
  152.     ' These functions evaluate functions.
  153.  
  154.     Function DoFunc1(ByVal m As Match) As String
  155.         ' function argument is 2nd group.
  156.         Dim n1 As Double = CDbl(m.Groups(2).Value)
  157.         ' function name is 1st group.
  158.         Select Case m.Groups(1).Value.ToUpper
  159.             Case "EXP"
  160.                 Return Math.Exp(n1).ToString
  161.             Case "LOG"
  162.                 Return Math.Log(n1).ToString
  163.             Case "LOG10"
  164.                 Return Math.Log10(n1).ToString
  165.             Case "ABS"
  166.                 Return Math.Abs(n1).ToString
  167.             Case "SQR", "SQRT"
  168.                 Return Math.Sqrt(n1).ToString
  169.             Case "SIN"
  170.                 Return Math.Sin(n1).ToString
  171.             Case "COS"
  172.                 Return Math.Cos(n1).ToString
  173.             Case "TAN"
  174.                 Return Math.Tan(n1).ToString
  175.             Case "ASIN"
  176.                 Return Math.Asin(n1).ToString
  177.             Case "ACOS"
  178.                 Return Math.Acos(n1).ToString
  179.             Case "ATAN"
  180.                 Return Math.Atan(n1).ToString
  181.         End Select
  182.     End Function
  183.  
  184.     Function DoFunc2(ByVal m As Match) As String
  185.         ' function arguments are 2nd and 3rd group.
  186.         Dim n1 As Double = CDbl(m.Groups(2).Value)
  187.         Dim n2 As Double = CDbl(m.Groups(3).Value)
  188.         ' function name is 1st group.
  189.         Select Case m.Groups(1).Value.ToUpper
  190.             Case "ATAN2"
  191.                 Return Math.Atan2(n1, n2).ToString
  192.         End Select
  193.     End Function
  194.  
  195.     Function DoFuncN(ByVal m As Match) As String
  196.         ' function arguments are from group 2 onward.
  197.         Dim args As New ArrayList()
  198.         Dim i As Integer = 2
  199.         ' Load all the arguments into the array.
  200.         Do While m.Groups(i).Value <> ""
  201.             ' Get the argument, replace any comma to space, and convert to double.
  202.             args.Add(CDbl(m.Groups(i).Value.Replace(","c, " "c)))
  203.             i += 1
  204.         Loop
  205.  
  206.         ' function name is 1st group.
  207.         Select Case m.Groups(1).Value.ToUpper
  208.             Case "MIN"
  209.                 args.Sort()
  210.                 Return args(0).ToString
  211.             Case "MAX"
  212.                 args.Sort()
  213.                 Return args(args.Count - 1).ToString
  214.         End Select
  215.     End Function
  216.  
  217. End Module
  218.